home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr09
/
cvec.zip
/
CVEC.BAS
next >
Wrap
BASIC Source File
|
1993-06-16
|
11KB
|
287 lines
'CVEC. Uses PAF data base to build file of C-Vectors. Output
'file contains the vector elements, sex, a file identification
'character, and name of the base individual.
'
'The C-Vector is an array of seven integers. Each element is the
'birth year of an individual as follows:
' 1 Individual
' 2 Father
' 3 Mother
' 4 Paternal Grandfather
' 5 Paternal Grandmother
' 6 Maternal Grandfather
' 7 Maternal Grandmother
' Taken as an individual indentifier, the C-Vector is very nearly unique.
' It is independent of data base format and vagaries of surname spelling.
' Once a single individual is found in common between two data bases,
' ancestors from that point back are held in common.
' C-Vector comparisons are gender independent - the same for male and
' female lines.
'
' For more information see article in July, 1990 issue of
' Genealogical Computing Magazine.
'
'Version 1.0. 3/23/90
'(c) Copyright 1990 Peter G. Cook, 435 E. Barbarita Ave., Gilbert, AZ.
DEFINT A-Z
DECLARE FUNCTION BirthYear$ (DateField$)
DECLARE SUB BuildName (Gender, Titl, G1, G2, G3, BuiltName$)
DECLARE SUB Grandparents (Pointer%, VN1$, VN2$)
DECLARE SUB GetName (NameNo%, NameWord$)
TYPE Place
Place1 AS INTEGER 'Placename 1
Place2 AS INTEGER 'Placename 2
Place3 AS INTEGER 'Placename 3
Place4 AS INTEGER 'Placename 4
END TYPE
TYPE Individual 'Individual file (INDIV2.DAT) format.
Sur AS INTEGER 'Surname
G1 AS INTEGER 'Given name 1
G2 AS INTEGER 'Given name 2
G3 AS INTEGER 'Given name 3
Titl AS INTEGER 'Title
Gender AS STRING * 1 'M = male, F = female, D = deleted
BDate AS STRING * 4 'Birthdate compacted
Birth AS Place 'Birth place pointers
CDate AS STRING * 4 'Christen date compacted
Christen AS Place 'Christen place pointers
DDate AS STRING * 4 'Death date compacted
Death AS Place 'Death place pointers
BurDate AS STRING * 4 'Burial death date compacted
Burial AS Place 'Burial place pointers
Baptdate AS STRING * 3 'Baptism date compacted
BaptTmple AS INTEGER 'Baptism temple
EDate AS STRING * 3 'Endowment date
ETempl AS INTEGER 'Endowment temple
CPSealDate AS STRING * 3 'Child to Parent sealing date
CPSealTmpl AS INTEGER 'Child to Parent sealing temple
SibPtr AS INTEGER 'Sibling pointer (RIN)
OwnMarriage AS INTEGER 'Own marriage MRIN
PMarriage AS INTEGER 'Parent Marriage MRIN
ID AS STRING * 10 'ID Field
NPointer AS INTEGER 'Note Pointer
END TYPE
TYPE Marriage 'Marriage file (MARR2.DAT) format.
Husband AS INTEGER 'Husband RIN
Wife AS INTEGER 'Wife RIN
Child AS INTEGER 'First child RIN
MDate AS STRING * 4 'Marriage date compacted
LocMarriage AS Place 'Location of marriage
WHSealDate AS STRING * 3 'Wife to Husband seal date
WHSealTempl AS INTEGER 'Wife to husband seal temple
HOtherMarriage AS INTEGER 'Husband other marriage MRIN
WOtherMarriage AS INTEGER 'Wife other marriage MRIN
Divorce AS STRING * 1 'Y = yes, D = deleted
END TYPE
TYPE NameWord 'Name file (NAME2.DAT) format.
LeftLink AS INTEGER
NameField AS STRING * 17 'Word pointed to by place & name ptrs
RightLink AS INTEGER
END TYPE
TYPE CVector 'Output C-Vector file format.
CV1 AS STRING * 5 'Individual birth year
CV2 AS STRING * 5 'Father's birth year
CV3 AS STRING * 5 'Mother's birth year
CV4 AS STRING * 5 'Paternal Grandfather's birth year
CV5 AS STRING * 5 'Paternal Grandmother's birth year
CV6 AS STRING * 5 'Maternal Grandfather's birth year
CV7 AS STRING * 5 'Maternal Grandmother's birthyear
Gender AS STRING * 1 'Gender
RIN AS STRING * 6 'Individual ident number
AName AS STRING * 20 'Ancestor's name
END TYPE
'Define specific record variable names, and open the files.
'User can specify another directory for the PAF files, or stick with
' the current one.
DIM SHARED NRec AS NameWord 'Name Record
DIM SHARED CVREC AS CVector 'C-Vector Record
DIM SHARED IRec AS Individual 'Individual Record
DIM SHARED FREC AS Individual 'Father Record
DIM SHARED MRec AS Individual 'Mother Record
DIM SHARED GFRec AS Individual 'Grandfather Record
DIM SHARED GMRec AS Individual 'Grandmother record
DIM SHARED PMRec AS Marriage 'Parents Marriage Record
DIM SHARED GPMRec AS Marriage 'Grandparents marriage record
DIM SHARED ElementCount
INPUT "Enter directory containing PAF Files, ENTER alone for current dir: ", DIR$
OPEN DIR$ + "\INDIV2.DAT" FOR RANDOM AS #2 LEN = 92 'Open Individual file
OPEN DIR$ + "\MARR2.DAT" FOR RANDOM AS #1 LEN = 28 'Open Marriage file
OPEN DIR$ + "\NAME2.DAT" FOR RANDOM AS #4 LEN = 21'Open Name file
'Get the filename of the output file desired. Full pathname is OK,
'or just file name for current directory.
INPUT "Enter name of output file to receive C-Vectors: ", CVecFName$
OPEN CVecFName$ FOR OUTPUT AS #3
'Get file identification letter to appear with each C-Vector
INPUT "Enter a single letter to identify this file's C_Vectors: ", Ltr$
Ltr$ = " " + LEFT$(Ltr$, 1) 'make sure it's just one letter, add space
VectorCount = 0 'Initialize count of vectors written
LastRecord = LOF(2) \ LEN(IRec) 'Find number of last record
FOR I = 2 TO LastRecord 'Skip the header record, step through individuals
CVREC.CV1 = " 0000" 'Set all of the C-Vector elements to " 0000"
CVREC.CV2 = " 0000" 'to indicates missing date.
CVREC.CV3 = " 0000"
CVREC.CV4 = " 0000"
CVREC.CV5 = " 0000"
CVREC.CV6 = " 0000"
CVREC.CV7 = " 0000"
ElementCount = 0 'Counter to keep track of valid element count
GET #2, I, IRec 'Read individual's record
'Don't process this record if it has been deleted.
IF IRec.Gender = "D" THEN GOTO BailOut
'Don't process this person if no birthyear available.
CVREC.CV1 = BirthYear$(IRec.BDate)
IF CVREC.CV1 = " 0000" THEN GOTO BailOut
CVREC.RIN = STR$(I - 1)
CVREC.Gender = IRec.Gender 'Move gender
IF IRec.Gender = "" THEN CVREC.Gender = "U"
'Generate ancestor name
CALL BuildName(IRec.Sur, IRec.Titl, IRec.G1, IRec.G2, IRec.G3, BuiltName$)
CVREC.AName = BuiltName$
ElementCount = ElementCount + 1 'Bump good element count
'Get Parent Marriage record if available, find parents or bail out.
'(Note that header record makes all random access record numbers
' = RIN or MRIN +1)
IF IRec.PMarriage = 0 THEN GOTO BailOut
GET #1, IRec.PMarriage + 1, PMRec 'Get parent's marriage
IF PMRec.Husband = 0 THEN GOTO BailOut 'Bail out if no Father
'Process Father
GET #2, PMRec.Husband + 1, FREC 'Get his record
CVREC.CV2 = BirthYear$(FREC.BDate) 'Move birthdate
IF CVREC.CV2 = " 0000" THEN GOTO BailOut 'Bail out if no birthdate
'Process paternal grandparents if available
IF FREC.PMarriage <> 0 THEN
CALL Grandparents(FREC.PMarriage + 1, CVREC.CV4, CVREC.CV5)
END IF 'Done looking for paternal line
'Process Mother and Maternal Grandparents
IF PMRec.Wife <> 0 THEN
GET #2, PMRec.Wife + 1, MRec 'Get her record
CVREC.CV3 = BirthYear$(MRec.BDate)
IF CVREC.CV3 <> " 0000" THEN ElementCount = ElementCount + 1
'Process maternal grandparents if available
IF MRec.PMarriage <> 0 THEN
CALL Grandparents(MRec.PMarriage + 1, CVREC.CV6, CVREC.CV7)
END IF
END IF 'Done looking for maternal line
'Now we will write out the C-Vector if we have found 3 or more years
IF ElementCount < 3 THEN GOTO BailOut
VectorCount = VectorCount + 1
PRINT #3, CVREC.CV1; CVREC.CV2; CVREC.CV3; CVREC.CV4; CVREC.CV5; CVREC.CV6; CVREC.CV7; " "; CVREC.Gender; Ltr$; CVREC.RIN; CVREC.AName
BailOut: NEXT I
PRINT VectorCount; " Records written to file "; CVecFName$
CLOSE 'Close all files
END 'Done
'Function to extract BirthYear from the PAF compact date format
FUNCTION BirthYear$ (DateField$)
D1$ = MID$(DateField$, 1, 1)
D2$ = MID$(DateField$, 2, 1)
BYr = ASC(D1$) * 16 + ASC(D2$) \ 16
IF BYr = 0 THEN
BirthYear$ = " 0000" 'Set to no year if none in record
ELSE BirthYear$ = STR$(BYr)
END IF
END FUNCTION
'Function to find 17 character name fields and pack into a single string
SUB BuildName (surname, Title, G1, G2, G3, BuiltName$) STATIC
CALL GetName(surname, SSurname$)'Get parts of name
CALL GetName(Title, STtitle$)
CALL GetName(G1, SG1$): SG1$ = " " + SG1$ ')get names,
CALL GetName(G2, SG2$): SG2$ = " " + SG2$ ')set spacing
CALL GetName(G3, SG3$): SG3$ = " " + SG3$ ')
BuiltName$ = " " + UCASE$(RTRIM$(SSurname$)) + "," + RTRIM$(STitle$) + RTRIM$(SG1$) + RTRIM$(SG2$) + RTRIM$(SG3$)
END SUB
'Subprogram to locate alphabetics with name file record pointers
SUB GetName (NameNo, NameW$) STATIC
SHARED NRec AS NameWord
IF NameNo = 0 THEN
NameW$ = "" 'Null string if no pointer
ELSE
RecNo = NameNo + 1
GET #4, RecNo, NRec 'Get the Name Word
NameW$ = NRec.NameField
FOR C = 1 TO 17 'make sure trailing characters are all spaces
T$ = MID$(NameW$, C, 1)
IF T$ < " " THEN MID$(NameW$, C, 1) = " "
NEXT C
END IF
END SUB
'Subprogram to process grandparents birth years
SUB Grandparents (Pointer, VN1$, VN2$)
GET #1, Pointer, GPMRec 'get their marriage
IF GPMRec.Husband <> 0 THEN 'Does he have a record?
GET #2, GPMRec.Husband + 1, GFRec 'Get it
VN1$ = BirthYear$(GFRec.BDate) 'Extract date
IF VN1$ <> " 0000" THEN
ElementCount = ElementCount + 1
END IF
END IF 'Grandfather processed
IF GPMRec.Wife <> 0 THEN 'Does she have a record?
GET #2, GPMRec.Wife + 1, GMRec 'Get it
VN2$ = BirthYear$(GMRec.BDate) 'Extract date
IF VN2$ <> " 0000" THEN
ElementCount = ElementCount + 1
END IF
END IF 'Grandmother processed
END SUB